home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / biz / cloan / AnimGIF_Update.lha / AnimGIF_Update / Rexx / LoadAnimGif.pprx next >
Text File  |  1996-12-18  |  7KB  |  285 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: LoadAnimGif.pprx 1.3 */
  4.  
  5. /** ENG
  6.  This script loads a GIF animation, and then either displays it with the
  7.  proper timing, or converts it into an IFF anim-brush (if the "Anim-Brush"
  8.  option is selected).
  9.  
  10.  GIF animation features such as frame-by-frame timing, multiple palettes,
  11.  control blocks, offsets and overlays are supported. Multiple transparencies
  12.  are not supported.
  13. */
  14.  
  15. /** DEU
  16.  Mit Hilfe dieses Skripts läßt sich eine GIF-Animation laden und dann
  17.  entweder mit dem korrekten Timing anzeigen oder in einen IFF-Anim-Brush
  18.  konvertieren (sofern die Option "Anim-Brush" aktiviert ist).
  19.  
  20.  Merkmale von GIF-Animationen, wie frameweises Timing, unterschiedliche
  21.  Paletten, Control Blocks, Offsets und Overlays werden unterstützt.
  22.  Unterschiedliche Transparenzwerte werden nicht unterstützt.
  23. */
  24.  
  25. IF ARG(1, EXISTS) THEN
  26.     PARSE ARG PPPORT
  27. ELSE
  28.     PPPORT = 'PPAINT'
  29.  
  30. IF ~SHOW('P', PPPORT) THEN DO
  31.     IF EXISTS('PPaint:PPaint') THEN DO
  32.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  33.         DO 30 WHILE ~SHOW('P',PPPORT)
  34.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  35.         END
  36.     END
  37.     ELSE DO
  38.         SAY "Personal Paint could not be loaded."
  39.         EXIT 10
  40.     END
  41. END
  42.  
  43. IF ~SHOW('P', PPPORT) THEN DO
  44.     SAY 'Personal Paint Rexx port could not be opened'
  45.     EXIT 10
  46. END
  47.  
  48. ADDRESS VALUE PPPORT
  49. OPTIONS RESULTS
  50. OPTIONS FAILAT 10000
  51.  
  52. Get 'LANG'
  53. IF RESULT = 1 THEN DO        /* Deutsch */
  54.     txt_title_req     = 'GIF-Anim-Brush laden'
  55.     txt_gad_absh      = 'Anim-_Brush:'
  56.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  57.     txt_err_oldlib    = 'Für dieses Skript ist eine neuere Version_der GIF library erforderlich'
  58.     txt_err_load      = 'Fehler beim Laden'
  59.     txt_err_notagif   = 'Die ausgewählte Datei enthält keine GIF-Animation'
  60.     txt_err_notsupp   = 'Das ausgewählte Animationsformat kann nicht geladen werden.'
  61.     txt_err_scrfmt    = 'Bildschirmformat kann nicht benutzt werden'
  62. END
  63. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  64.     txt_title_req     = 'Leggere Anim-brush GIF'
  65.     txt_gad_absh      = 'Anim-_Brush:'
  66.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  67.     txt_err_oldlib    = 'Questa procedura richiede_una versione più recente_della libreria GIF'
  68.     txt_err_load      = 'Errore nelle lettura del file'
  69.     txt_err_notagif   = 'Il file selezionato_non contiene un''animazione GIF'
  70.     txt_err_notsupp   = 'Il tipo di animazione non può essere letto'
  71.     txt_err_scrfmt    = 'Il formato di schermo non può essere utilizzato'
  72. END
  73. ELSE DO                /* English */
  74.     txt_title_req     = 'Load GIF Anim-Brush'
  75.     txt_gad_absh      = 'Anim-_Brush:'
  76.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  77.     txt_err_oldlib    = 'This script requires a newer_version of the GIF library'
  78.     txt_err_load      = 'Load error'
  79.     txt_err_notagif   = 'The selected file_does not contain_a GIF animation'
  80.     txt_err_notsupp   = 'The selected animation type_cannot be loaded'
  81.     txt_err_scrfmt    = 'The screen format cannot be set'
  82. END
  83.  
  84. Version 'REXX'
  85. IF RESULT < 7 THEN DO
  86.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  87.     EXIT 10
  88. END
  89.  
  90. LockGUI
  91. RequestFile '"'txt_title_req'"'
  92. IF RC = 0 THEN DO
  93.     gfile = RESULT
  94.     getbsh = LoadSet('GetBsh', 1)
  95.  
  96.     Request '"'txt_title_req'" "CHECK = ""'txt_gad_absh'"", 'getbsh'"'
  97.     IF RC = 0 THEN DO
  98.         getbsh = RESULT.1
  99.         CALL SaveSet('GetBsh', getbsh)
  100.         frame = 1
  101.         loop = -1
  102.         delays = ''
  103.         err_msg = ''
  104.         setup = 1
  105.  
  106.         Get 'GCLIP'
  107.         saveclip = RESULT
  108.         Set '"GCLIP=0"'
  109.  
  110.         DO FOREVER
  111.             LoadBrush gfile 'QUIET NOPROGRESS FORMAT "GIF" OPTIONS "FRAME='frame'"'
  112.             IF RC = 0 THEN DO
  113.                 IF setup THEN DO
  114.                     setup = 0
  115.                     SwitchEnvironment
  116.                     FreeEnvironment 'QUERY'
  117.                     IF RC ~= 0 THEN
  118.                         LEAVE
  119.                     DeleteFrames 'ALL FORCE'
  120.                     SetPen 'BACKGROUND 0'
  121.                     ClearImage
  122.                     GetBrushAttributes 'COLORS'
  123.                     cnum = RESULT
  124.                     GetBrushAttributes 'WIDTH'
  125.                     brushw = RESULT
  126.                     GetBrushAttributes 'HEIGHT'
  127.                     brushh = RESULT
  128.                     IF SetScreenFormat(brushw, brushh, cnum, 1) ~= 0 THEN DO
  129.                         IF SetScreenFormat(brushw, brushh, cnum, 0) ~= 0 THEN DO
  130.                             err_msg = txt_err_scrfmt
  131.                             LEAVE
  132.                         END
  133.                     END
  134.                     GetBrushAttributes 'TRANSPARENCY'
  135.                     transp = RESULT
  136.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  137.                     transpcol = RESULT
  138.                     SetPen 'BACKGROUND' transpcol
  139.                     ClearImage
  140.                     AddFrames
  141.                 END
  142.                 ELSE DO
  143.                     GetBrushAttributes 'TRANSPARENCY'
  144.                     transp2 = RESULT
  145.                     GetBrushAttributes 'TRANSPARENTCOLOR'
  146.                     transpcol2 = RESULT
  147.                     IF transp2 ~= transp | transpcol2 ~= transpcol THEN DO
  148.                         err_msg = txt_err_notsupp
  149.                         LEAVE
  150.                     END
  151.                 END
  152.                 UseBrushPalette
  153.                 SetPaintMode 'REPLACE'
  154.                 SetBrushAttributes 'HANDLEX 0 HANDLEY 0'
  155.                 PutBrush 0 0
  156.  
  157.                 GetBrushInfo 'ANNOTATION'
  158.                 IF RC = 0 THEN DO
  159.                     PARSE VALUE RESULT WITH 'LOOP ' loop ' DELAY ' delay .
  160.                     IF DATATYPE(delay, 'W') THEN DO
  161.                         delays = delays delay
  162.                         ticks = TRUNC(delay / 100 * 60 + 0.5)
  163.                         SetFrameDelay ticks
  164.                     END
  165.                 END
  166.  
  167.                 AddFrames
  168.                 SetFramePosition 'NEXT'
  169.                 frame = frame + 1
  170.             END
  171.             ELSE DO
  172.                 IF RC = 38 | (RC = 39 & frame <= 2) THEN
  173.                     err_msg = txt_err_notagif
  174.                 ELSE IF RC = 47 THEN
  175.                     err_msg = txt_err_oldlib
  176.                 ELSE IF RC ~= 39 THEN
  177.                     err_msg = txt_err_load
  178.                 LEAVE
  179.             END
  180.         END
  181.  
  182.         annot = ''
  183.         LoadBrush gfile 'QUIET NOPROGRESS'    /* reset to normal load (AUTO) */
  184.         IF RC = 0 THEN DO
  185.             GetBrushInfo 'ANNOTATION'
  186.             IF RC = 0 THEN
  187.                 annot = RESULT
  188.         END
  189.         FreeBrush 'FORCE'
  190.         DeleteFrames
  191.  
  192.         IF err_msg ~= '' THEN DO
  193.             RequestNotify 'PROMPT "'err_msg'"'
  194.             FreeEnvironment 'FORCE'
  195.         END
  196.         ELSE DO
  197.             SetFramePosition 1
  198.             IF RC = 0 THEN DO
  199.                 IF getbsh THEN DO
  200.                     Get 'TRANSP'
  201.                     sv_transp = RESULT
  202.  
  203.                     IF transp = 1 THEN
  204.                         Set '"TRANSP=' transp '"'
  205.                     ELSE
  206.                         Set '"TRANSP=0"'
  207.                     GetFrames
  208.                     DefineBrush 0 0 brushw-1 brushh-1 RESULT
  209.                     IF RC = 0 THEN DO
  210.                         FreeEnvironment 'FORCE'
  211.                         SetBrushInfo 'ANNOTATION "LOOP' loop 'DELAY' delays'"'
  212.                         IF annot ~= '' THEN DO
  213.                             pos = 1
  214.                             DO FOREVER
  215.                                 pos = INDEX(annot, '"', pos)
  216.                                 IF pos = 0 THEN
  217.                                     BREAK
  218.                                 annot = INSERT('"', annot, pos)
  219.                                 pos = pos + 2
  220.                             END
  221.                             SetBrushInfo 'COPYRIGHT "'annot'"'
  222.                         END
  223.                     END
  224.  
  225.                     Set '"TRANSP=' sv_transp '"'
  226.                 END
  227.                 ELSE Play 'FORCE'
  228.             END
  229.         END
  230.         Set '"GCLIP='saveclip'"'
  231.     END
  232. END
  233. UnlockGUI
  234.  
  235. EXIT 0
  236.  
  237.  
  238.  
  239.  
  240. SetScreenFormat: PROCEDURE
  241.  
  242.     width  = ARG(1)
  243.     height = ARG(2)
  244.     cnum   = ARG(3)
  245.  
  246.     IF ARG(4) ~= 0 THEN
  247.         GetBestVideoMode width height cnum 'ANIMATION'
  248.     ELSE
  249.         GetBestVideoMode width height cnum
  250.  
  251.     IF RC = 0 THEN DO
  252.         PARSE VAR RESULT scrd scrw scrh
  253.         Set '"IMAGEW='width'" "IMAGEH='height'" "COLORS='cnum'" "DISPLAY='scrd'" "SCREENW='scrw'" "SCREENH='scrh'" "ASCROLL=0"'
  254.     END
  255.  
  256.     RETURN RC
  257.  
  258.  
  259.  
  260.  
  261. SaveSet: PROCEDURE
  262.     sname = ARG(1)
  263.     val = ARG(2)
  264.  
  265.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'W') THEN DO
  266.         CALL WRITECH('settingfile', val)
  267.         CALL CLOSE('settingfile')
  268.     END
  269.  
  270.     RETURN
  271.  
  272.  
  273.  
  274.  
  275. LoadSet: PROCEDURE
  276.     sname = ARG(1)
  277.     val = ARG(2)
  278.  
  279.     IF OPEN('settingfile', 'ENV:PP_LoadAnimGIF_'sname, 'R') THEN DO
  280.         val = READCH('settingfile', 65535)
  281.         CALL CLOSE('settingfile')
  282.     END
  283.  
  284.     RETURN val
  285.